home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / vol.com / VOL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-01-19  |  5.2 KB  |  215 lines
  1.                                                                                {
  2. Program ..............:  Vol.pas
  3. Purpose ..............:  Manipulation of Disk Volume Labels.
  4. Implementation .......:  Turbo Pascal v4.x, v5.x
  5.  
  6. Original Code.........:  Vernon E. Davis
  7.                       :  17 South Centre Street
  8.                       :  Merchantville, NJ 08109
  9.                       :  CompuServe [71330,2705]
  10.  
  11. Revision....1/19/90...:  Mikal B. Keenan
  12.                       :  UAB Computer Science
  13.                       :  Campbell Hall
  14.                       :  University of Alabama at Birmingham
  15.                       :  University Station
  16.                       :  Birmingham, AL 35209
  17.                       :  Compuserve 76167,1033
  18.  
  19.   ***********************************************************
  20.   I hate to write documentation so I included the original DOC
  21.   file with my revisions.  Sorry I didn't include the original
  22.   code Vern... once I started typing and saving - and getting
  23.   my changes to work - I zipped my work back into the archive!
  24.   I've made the routines much tighter and unrepetitive.  Also
  25.   wrote a functional LABEL program based on the original Vol-
  26.   Test code.  Enjoy folks - it was fun.
  27.  
  28.   reuploaded by Mikal Keenan  1/19/90
  29.   ***********************************************************
  30.                                                                                }
  31. {$V-}
  32. unit Vol;
  33.  
  34. interface
  35.  
  36. uses
  37.  
  38.    dos;
  39.  
  40. type
  41.  
  42.    Drive       = byte;
  43.    VolumeName  = string[11];
  44.  
  45.    VolFCB      = record
  46.                     FCB_Flag : byte;
  47.                     Reserved : array[1..5] of byte;
  48.                     FileAttr : byte;
  49.                     Drive_ID : byte;
  50.                     FileName : array[1..8] of byte;
  51.                     File_Ext : array[1..3] of byte;
  52.                     Unused_A : array[1..5] of byte;
  53.                     File_New : array[1..8] of byte;
  54.                     fExt_New : array[1..3] of byte;
  55.                     Unused_B : array[1..9] of byte
  56.                  end;
  57.  
  58.    function DelVol (D:Byte):Boolean;
  59.    function AddVol (D:Byte; V:VolumeName):Boolean;
  60.    function ChgVol (D:Byte; V:VolumeName):Boolean;
  61.    function GetVol (D:Byte):VolumeName;
  62.  
  63. implementation
  64.  
  65. procedure Pad_Name (var V:VolumeName);
  66. begin
  67.    while Length (V) <> 11 do
  68.       V:= V + ' '
  69. end;
  70.  
  71. function Fix_Ext_Sym (var V:VolumeName):byte;
  72. var
  73.    I : byte;
  74. begin
  75.    I:= Pos ('.',V);
  76.    if I > 0 then
  77.       Delete (V,I,1);
  78.    Fix_Ext_Sym:= I
  79. end;
  80.  
  81. function Extract_Name (S:SearchRec):VolumeName;
  82. var
  83.    H, I : Byte;
  84. begin
  85.    I:= Fix_Ext_Sym (S.Name);
  86.    if (I > 0) and (I < 9) then
  87.       for H:= 1 to (9 - I) do
  88.          Insert (' ', S.Name, I);
  89.    Extract_Name:= S.Name
  90. end;
  91.  
  92. procedure Fix_Name (var V:VolumeName);
  93. var
  94.    I : byte;
  95. begin
  96.    Pad_Name (V);
  97.    for I:= 1 to 11
  98.       do V[I]:= Upcase (V[I])
  99. end;
  100.  
  101. function Valid_Drive_Num (D:Byte):Boolean;
  102. begin
  103.    Valid_Drive_Num:= (D >= 1) and (D <= 26)
  104. end;
  105.  
  106. function Find_Vol (D:Byte; var S:SearchRec):boolean;
  107. begin
  108.    FindFirst (chr (D+64) + ':\*.*',VolumeID, S);
  109.    Find_Vol:= DosError = 0
  110. end;
  111.  
  112. procedure Fix_FCB_NewFile (V:VolumeName; var FCB:VolFCB);
  113. var
  114.    I : byte;
  115. begin
  116.    for I:= 1 to 8 do
  117.       FCB.File_New[I]:= ord (V[I]);
  118.    for I:= 1 to 3 do
  119.       FCB.fExt_New[I]:= ord (V[I+8])
  120. end;
  121.  
  122. procedure Fix_FCB_FileName (V:VolumeName; var FCB:VolFCB);
  123. var
  124.    I : byte;
  125. begin
  126.    for I:= 1 to 8 do
  127.       FCB.FileName[I]:= ord (V[I]);
  128.    for I:= 1 to 3 do
  129.       FCB.File_Ext[I]:= ord (V[I+8])
  130. end;
  131.  
  132. function Vol_Int21 (Fnxn:word; D:Drive; var FCB:VolFCB):boolean;
  133. var
  134.    Regs : registers;
  135. begin
  136.    FCB.Drive_ID:= D;
  137.    FCB.FCB_Flag:= $FF;
  138.    FCB.FileAttr:= $08;
  139.    Regs.DS     := Seg (FCB);
  140.    Regs.DX     := Ofs (FCB);
  141.    Regs.AX     := Fnxn;
  142.    Msdos (Regs);
  143.    Vol_Int21:= Regs.AL = 0
  144. end;
  145.  
  146. function DelVol (D:Byte):Boolean;
  147. var
  148.    sRec : SearchRec;
  149.    FCB  : VolFCB;
  150.    V    : VolumeName;
  151. begin
  152.    DelVol:= false;
  153.    if Valid_Drive_Num (D) then
  154.       begin
  155.      if Find_Vol (D, sRec) then
  156.             begin
  157.                V:= Extract_Name (sRec);
  158.            Pad_Name (V);
  159.            Fix_FCB_FileName (V, FCB);
  160.            DelVol:= Vol_Int21 ($1300, D, FCB)
  161.             end
  162.       end
  163. end;
  164.  
  165. function AddVol (D:Byte; V:VolumeName):Boolean;
  166. var
  167.    sRec : SearchRec;
  168.    FCB  : VolFCB;
  169. begin
  170.    AddVol:= false;
  171.    if Valid_Drive_Num (D) then
  172.       begin
  173.      if not Find_Vol (D, sRec) then
  174.         begin
  175.            Fix_Name (V);
  176.            Fix_FCB_FileName (V, FCB);
  177.            AddVol:= Vol_Int21 ($1600, D, FCB)
  178.             end
  179.       end
  180. end;
  181.  
  182. function ChgVol (D:Byte; V:VolumeName):Boolean;
  183. var
  184.    sRec : SearchRec;
  185.    FCB  : VolFCB;
  186.    x    : byte;
  187. begin
  188.    ChgVol:= false;
  189.    if Valid_Drive_Num (D) then
  190.       begin
  191.      if Find_Vol (D, sRec) then
  192.             begin
  193.            x:= Fix_Ext_Sym (V);
  194.            Fix_Name (V);
  195.            Fix_FCB_NewFile (V, FCB);
  196.                V:= Extract_Name (sRec);
  197.            Pad_Name (V);
  198.            Fix_FCB_FileName (V, FCB);
  199.            ChgVol:= Vol_Int21 ($1700, D, FCB)
  200.             end
  201.       end
  202. end;
  203.  
  204. function GetVol (D:Byte):VolumeName;
  205. var
  206.    sRec : SearchRec;
  207. begin
  208.    GetVol:= '';
  209.    if Valid_Drive_Num (D) then
  210.       if Find_Vol (D, sRec) then
  211.      GetVol:= Extract_Name (sRec)
  212. end;
  213.  
  214. end.
  215.